source("code/setup.R")
df <- read_csv("data/available_upon_request/whole_brain_data.csv")
df <- df |> mutate(dx=as.factor(dx))

roidf <- read_csv("data/available_upon_request/processed_ROI_data.csv") |> filter(dx==0)
roidfdx1 <- read_csv("data/available_upon_request/processed_ROI_data.csv") |> filter(dx==1)
ROI_Gcosinor <- read_rds("output/ROI_G-cosinor.rds")
ROI_Gcosinor_dx1 <- read_rds("output/ROI_cosinor_stats_BPD/ROI_G-cosinor_dx1.rds")
ROI_Gcosinor_dx01 <- read_rds("output/ROI_cosinor_stats_BPD/ROI_G-cosinor_dx01.rds")
ROI_AA <- read_rds("output/ROI_AA.rds")
ROI_AA_dx1 <- read_rds("output/ROI_cosinor_stats_BPD/ROI_AA_dx1.rds")
ROI_AA_dx01 <- read_rds("output/ROI_cosinor_stats_BPD/ROI_AA_dx01.rds")
# Merge all stats used throughout
roi_sumtab <- Reduce(function(x, y, ...) merge(x, y, all = TRUE, ...),
                     list(ROI_Gcosinor |> select(measure,roi,p_gc = pvalue),
                          ROI_AA |> select(measure,roi,p_AA = p),
                          ROI_Gcosinor_dx1 |> select(measure,roi,p_gc_bpd = pvalue),
                          ROI_Gcosinor_dx01 |> select(measure,roi,p_gc_com = pvalue),
                          ROI_AA_dx1 |> select(measure,roi,p_AA_bpd = p),
                          ROI_AA_dx01 |> select(measure,roi,p_AA_com = p)))

# Whole brain statistics
WB_Gcosinor_dx0 <- read_rds("output/WB_G-cosinor.rds")
WB_Gcosinor_dx1 <- read_rds("output/WB_cosinor_stats_BPD/WB_G-cosinor_dx1.rds")
WB_Gcosinor_dx01 <- read_rds("output/WB_cosinor_stats_BPD/WB_G-cosinor_dx01.rds")
WB_AA <- read_rds("output/WB_AA.rds")
WB_AA_dx1 <- read_rds("output/WB_cosinor_stats_BPD/WB_AA_dx1.RDS")
WB_AA_dx01 <- read_rds("output/WB_cosinor_stats_BPD/WB_AA_dx01.RDS")
wb_sumtab <- list(
     WB_Gcosinor_dx0 |> 
        select(measure,es=rsqdm,es2=rsq,pvalue) |> mutate(test="Gcos",grp="CTRL"),
     WB_Gcosinor_dx1 |> 
        select(measure,es=rsqdm,es2=rsq,pvalue) |> mutate(test="Gcos",grp="BPD"),
     WB_Gcosinor_dx01 |> 
        select(measure,es=rsqdm,es2=rsq,pvalue) |> mutate(test="Gcos",grp="Combined"),
     WB_AA |> 
        select(measure,es=chisq,pvalue=p) |> mutate(test="Fishers",grp="CTRL",es2=NA),
     WB_AA_dx1 |> 
        select(measure,es=chisq,pvalue=p) |> mutate(test="Fishers",grp="BPD",es2=NA),
     WB_AA_dx01 |> 
        select(measure,es=chisq,pvalue=p) |> mutate(test="Fishers",grp="Combined",es2=NA)
     ) |> rbindlist(use.names = T) |> rename(p=pvalue)

bsc <- rbind(read_rds("output/WB_S-cosinor.rds") |> 
                mutate(dx=factor(0,levels=c(0,1))),
       read_rds("output/WB_cosinor_stats_BPD/WB_S-cosinor_dx1.rds"))
WB_acrodiffvar <- read_rds("output/WB_BPD_diffs/WB_acrodiffvar_test.RDS")

WB_Gcosinor  <- 
  WB_Gcosinor_dx1 |>
    select(amplitude,measure) |> 
    inner_join(WB_Gcosinor_dx1) |> 
    rename(acro_pcf = acrophase) |> 
    rename(p_pct = pvalue)

d2 <- 
    bsc |> 
    select(acro_sscf=acrophase,amp_sscf=amplitude,measure,p_ssct=pvalue,dx) |> 
    mutate(measure=factor(measure,levels = fig1_modord)) |> 
    arrange(measure)

plotdf <- WB_Gcosinor |> inner_join(d2,by="measure") |> 
    mutate(measure=factor(measure,levels = fig1_modord)) |> 
    arrange(measure)

Figure 4a: Polar

# Acrophase consistency
dxres <- 
    bsc |> 
    group_by(measure,dx) |> 
  summarize(cohort_resultant=acro2complex(acrophase) |> mean() |> abs(),
            cm = circamean(acrophase)) |>
  mutate(dxlab=dx2lab(dx)) |> 
  rbind(bsc |> 
    group_by(measure) |> 
  summarize(cohort_resultant=acro2complex(acrophase) |> mean() |> abs(),
            cm = circamean(acrophase),dxlab="Combined"))


diffacrovar_ms <- WB_acrodiffvar$measure[WB_acrodiffvar$p<0.05]
labmap <-
    WB_Gcosinor_dx0 |> ungroup() |> 
    arrange(match(measure,fig1_modord)) |>
    mutate(label=factor(measure,ordered=T,levels=fig1_modord,
                        labels = paste0(int2extlab[measure],
                                        ifelse(measure %in% diffacrovar_ms,
                                               "-Delta(abs(rho))-p<0.05","")
                                        ))) |>
    select(measure,label) |> unique() 

# (Partial) Source Data
fig4aSD <- 
  dxres |> 
  ungroup() |> 
  select(cohort_resultant,cm,dxlab,measure) |> 
  inner_join(
    rbind(
      WB_Gcosinor_dx0 |> 
        ungroup() |> 
        filter(pvalue<0.05) |> 
        select(measure,acrophase,acro_l,acro_u) |> 
        mutate(dxlab="CNTRL"),
      WB_Gcosinor_dx01 |> 
        ungroup() |> 
        filter(pvalue<0.05) |> 
        select(measure,acrophase,acro_l,acro_u) |> 
        mutate(dxlab="Combined"),
      WB_Gcosinor_dx1 |> 
        ungroup() |> 
        filter(pvalue<0.05) |> 
        select(measure,acrophase,acro_l,acro_u) |> 
        mutate(dxlab="BPD"))
  ) |> 
  mutate(measure=int2extlab[measure])
write_csv(fig4aSD,"output/source_data/Figure_4a_partial.csv")

Gcos_3grp_acrotick_p <- 
    plotdf |>
    inner_join(labmap) |> 
    ggplot(aes(acro_sscf,1-p_ssct))+
    ylab(expression(abs(rho)))+
    night_rect_early()+
    geom_rect(xmin=0,xmax=24,ymin=0,ymax=1,alpha=0.1,color=NA,fill="whitesmoke")+
    geom_rect(xmin=0,xmax=24,ymin=-Inf,ymax=0,fill="white")+
    geom_hline(yintercept = 1,color="black",size=0.2)+
    geom_hline(yintercept = 0.5,color="black",size=0.2,linetype=3)+
  annotate(geom="segment",x=seq(0,24,3),y=2.2,yend=0,xend=seq(0,24,3),
             color="grey90",size=0.3)+
    geom_text(aes(color=dx2lab(dx),y=1,
                  angle=-acro_sscf/24*360-90),
              size=5,label="-")+
    # G-cosinor dx1
    geom_point(data = plotdf |> filter(p_pct<0.05) |> inner_join(labmap),
               aes(acro_pcf,y=1.6,color=ifelse(p_pct<0.05,"BPD",NA)),size=1.2)+
    geom_errorbar(data = plotdf |> filter(p_pct<0.05) |> inner_join(labmap),
                  aes(xmin=acro_u, xmax=acro_l,y=1.6,
                    color=ifelse(p_pct<0.05,"BPD",NA)),width=0.25)+
    # G-cosinor dx0
    geom_point(data = WB_Gcosinor_dx0 |> filter(pvalue<0.05) |> inner_join(labmap),
               aes(acrophase,y=1.3,color=ifelse(pvalue<0.05,"CNTRL",NA)),size=1.2)+
    geom_errorbar(data = WB_Gcosinor_dx0 |> filter(pvalue<0.05) |> inner_join(labmap),
                  aes(xmin=acro_u,x=acrophase, 
                    xmax=acro_l,y=1.3, color=ifelse(pvalue<0.05,"CNTRL",NA)),width=0.25)+
    # G-cosinor dx0dx1
    geom_point(data = WB_Gcosinor_dx01 |> filter(pvalue<0.05) |> inner_join(labmap),
               aes(acrophase,y=1.9,color=ifelse(pvalue<0.05,"Combined",NA)),size=1.2)+
    geom_errorbar(data = WB_Gcosinor_dx01 |> filter(pvalue<0.05) |> inner_join(labmap),
                  aes(xmin=acro_u,x=acrophase, 
                    xmax=acro_l,y=1.9, color=ifelse(pvalue<0.05,"Combined",NA)),width=0.25)+
    geom_segment(data=dxres |> inner_join(labmap),
                 aes(xend=cm,x=cm,y=0,yend=cohort_resultant,color=dxlab),
                    size=0.5,alpha=0.8,
                 arrow = arrow(type = "closed",length = unit(0.8,"mm")))+
    scale_color_manual(values=c("BPD"=colors$dx1,
                                "CNTRL"=colors$dx0,
                                "Combined"=colors$dx01),guide='none')+
    facet_wrap(label~.,nrow=3,labeller = label_parsed)+
    theme(panel.border = element_blank(), 
          panel.background = element_blank(), 
          panel.grid = element_blank(),
          panel.spacing.x = unit(0,"line")) +
    coord_polar()+
    theme(panel.grid = element_blank())+
    theme(panel.spacing = unit(0, "lines"))+
    scale_y_continuous(breaks = c(0,1),limits = c(-0,2.2))+
  scale_x_continuous(limits = c(0,24), breaks=seq(0,24,6))+
  xlab("Acrophase (hr)")+
  theme_condense()+ theme(panel.border = element_blank(), 
                          panel.background = element_blank(),
                          #Legend
                          legend.title.align = 0,
                          legend.position = "right",
                          legend.title = element_text(size=8, vjust = 0, hjust = -3),
                          panel.spacing.x = unit(0.5,"line")
  )
Gcos_3grp_acrotick_p 

Spatial summary

Additional ROIs for combined Gcos

Extract stats referenced in text for “new” ROIs identified by combined (“FALSE TRUE”).

G-cosinor

roi_sumtab |> 
  group_by(measure) |> 
  mutate(class=paste(p.adjust(p_gc,"fdr")<0.05,p.adjust(p_gc_com,"fdr")<0.05)) |> 
  group_by(measure,class) |> count() |> 
  filter(class=="FALSE TRUE")
# A tibble: 3 × 3
# Groups:   measure, class [3]
  measure class          n
  <chr>   <chr>      <int>
1 cbf     FALSE TRUE    17
2 fa      FALSE TRUE     8
3 gm_md   FALSE TRUE   117

AA

roi_sumtab |> 
  group_by(measure) |> 
  mutate(class=paste(p.adjust(p_AA,"fdr")<0.05,
                     p.adjust(p_AA_com,"fdr")<0.05)) |> 
  group_by(measure,class) |> count() |> 
  filter(class=="FALSE TRUE")
# A tibble: 4 × 3
# Groups:   measure, class [4]
  measure class          n
  <chr>   <chr>      <int>
1 cbf     FALSE TRUE   119
2 gm_md   FALSE TRUE   101
3 md      FALSE TRUE     2
4 qt1     FALSE TRUE    93

Or the simple difference in #ROIs

roi_sumtab |> 
  group_by(measure) |> 
  summarize(n_gc=sum(p.adjust(p_gc,"fdr")<0.05),
            n_gc_com=sum(p.adjust(p_gc_com,"fdr")<0.05),
            n_AA=sum(p.adjust(p_AA,"fdr")<0.05),
            n_AA_com=sum(p.adjust(p_AA_com,"fdr")<0.05)) |> 
  mutate(diff_gc=n_gc_com-n_gc,
         diff_AA=n_AA_com-n_AA)
# A tibble: 9 × 7
  measure  n_gc n_gc_com  n_AA n_AA_com diff_gc diff_AA
  <chr>   <int>    <int> <int>    <int>   <int>   <int>
1 cbf       289      265   128      246     -24     118
2 ct          0        0     0        0       0       0
3 fa          0        8     0        0       8       0
4 gm_md      53      168    36      136     115     100
5 md          3        0     1        3      -3       2
6 qt1         0        0     4       97       0      93
7 sa          0        0     0        0       0       0
8 vol         0        0     0        0       0       0
9 wm_qt1      0        0     0        0       0       0

All

library(ggseg)
library(ggsegGlasser)
meta <- get_glasser_spatial_meta()
predat <- roi_sumtab |> 
    pivot_longer(c(p_gc,p_AA,p_AA_bpd,
                  p_AA_com,p_gc_bpd,p_gc_com)) |> 
    group_by(name,measure) |> 
    mutate(q=p.adjust(value,"fdr")) |> 
    mutate(name=factor(c("p_gc"="CNTRL Gcos",
                  "p_AA"="CNTRL Fishers",
                  "p_gc_bpd"="BPD Gcos",
                  "p_AA_bpd"="BPD Fishers",
                  "p_AA_com"="Combined Fishers",
                  "p_gc_com"="Combined Gcos")[name],
                  levels=c("CNTRL Gcos","CNTRL Fishers",
                         "BPD Fishers","BPD Gcos",
                         "Combined Fishers","Combined Gcos"),
                  labels = c("CNTRL Gcos (n=16)","CNTRL Fishers (n=16)",
                         "BPD Fishers (n=8)","BPD Gcos (n=8)",
                         "Combined Fishers (n=24)","Combined Gcos (n=24)"))) |> 
    group_by(measure,name) |> 
    mutate(n=sum(q<0.05),ntot=n()) |> 
    filter(n>0) |>
    mutate(value=ifelse(q<0.05,value,NA))

# Don't forget about these
predat |> 
    select(n,ntot,name,measure) |> 
    unique() |> 
    filter(measure %in% c("wm_qt1","fa","md"))
# A tibble: 5 × 4
# Groups:   measure, name [5]
      n  ntot name                    measure
  <int> <int> <fct>                   <chr>  
1     5    46 BPD Gcos (n=8)          fa     
2     8    46 Combined Gcos (n=24)    fa     
3     3    46 CNTRL Gcos (n=16)       md     
4     1    46 CNTRL Fishers (n=16)    md     
5     3    46 Combined Fishers (n=24) md     

Regional Highlights

Combined GM-MD

library(ggsegGlasser)
library(ggseg)
meta <- get_glasser_spatial_meta()
meta_glass <- get_glasser_spatial_meta()

fig4bSD <- 
  ROI_Gcosinor_dx01 |> 
    filter(measure =="gm_md") |> 
    mutate(acrophase=ifelse(qvalue<0.05,acrophase,NA)) |> 
  select(measure,roi,qvalue,acrophase)
write_csv(fig4bSD |> mutate(measure=int2extlab[measure]),
          "output/source_data/Figure_4b_part1.csv")

gmmdcombgc <- 
  inner_join(fig4bSD,meta) |>
    ggplot(aes(fill=acrophase))+
    facet_wrap(~int2extlab[measure],nrow=5)+
    theme_condense()+
    scale_fill_clock(rot=15,na.value="grey95")+
    geom_brain(atlas = glasser,
               position=position_brain(side ~ hemi),
               color="grey",size=0.1)+
    theme_void()
gmmdcombgc

WM-FA

# WM-FA Gcos comb
library(ggsegICBM)
library(plotly)
library(ggseg3d)
meta <- get_icbm_spatial_meta()

# Source Data
fig4bSD2 <- 
  ROI_Gcosinor_dx01 |> 
  filter(measure=="fa") |> 
  mutate(acrophase=ifelse(qvalue<0.05,acrophase,NA)) |> 
  select(measure,roi,qvalue,acrophase)
write_csv(fig4bSD2 |> mutate(measure=int2extlab[measure]),
          "output/source_data/Figure_4b_part2.csv")

pdf2 <- inner_join(fig4bSD2,meta) |> icbm_preprocess()
pdf2$region %in% icbm_3d$ggseg_3d[[1]]$region
 [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
[21] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
[41] TRUE TRUE TRUE TRUE TRUE
rot=15
pal <- 1:24
names(pal) <- rainbow(24)[((1:24)-1+rot)%%24+1]

p3d <- pdf2 |>  
    select(region,acrophase,roi) |> 
    ggseg3d(atlas = icbm_3d,colour="acrophase",
            palette = pal,na.alpha = 0.01) |> 
    add_glassbrain(opacity=0.05) |>
    pan_camera("right lateral") |>
    remove_axes()
p3d

GM-qT1 (AA)

ROI_Scosinor <- read_rds("output/ROI_cosinor_stats_BPD/ROI_S-cosinor_dx01.rds") |> unnest(bsc)
sigrois <- ROI_AA_dx01 |> 
  filter(measure=="qt1") |> 
  filter(q<0.05) |> 
  pull(roi)

# Source Data
fig4cSD <-
  ROI_Scosinor |>   
  filter(measure=="qt1") |> 
  group_by(measure,roi) |>
  summarize(var=1-acrophase |> acro2complex() |> mean() |> abs()) |> 
  mutate(var=ifelse((roi %in% (sigrois)),var,NA))
  # filter(roi %in% (sigrois))  
write_csv(fig4cSD |> mutate(measure=int2extlab[measure]),
          "output/source_data/Figure_4c.csv")

gmqt1combaa <-
  fig4cSD |> 
  inner_join(meta_glass) |>  
  ggplot(aes(fill=var))+
  facet_grid(measure~.)+
  theme_condense()+
  scale_fill_gradientn(colours = c("blue","#C26179"),
                       na.value="grey95",limits=c(0,1))+
  guides(colour = guide_coloursteps(show.limits = TRUE))+
  labs(fill="Acrophase Variance")+
  geom_brain(atlas = glasser,
             position=position_brain(side ~ hemi),color="grey50",size=0.05)+
  theme_void()+
  geom_text(aes(x=320,y=220,
                label=paste0(length(sigrois),"/",nrow(ROI_AA_dx01 |> filter(measure=="qt1")))),size=3)+
  theme(panel.background = element_rect(color="grey80",size=0.1))+
  theme(panel.spacing.x = unit(0, "lines"))+
  theme(panel.spacing.y = unit(0, "lines"))
gmqt1combaa

Subcortical

GM-MD

myaseg <- get_subcor_ggseg_atlas()
# Used to remove
meta <- get_glasser_spatial_meta()

# gmmdcombgc <- 
fig4bSD |> 
  full_join(meta) |> 
    filter(measure =="gm_md") |>  
  mutate(acrophase=ifelse(qvalue<0.05,acrophase,NA)) |> 
  filter(is.na(`z-cog`)) |>  # To remove non-subcortical 
  rename(label=roi) |> #pull(label)
  filter(qvalue<0.05) |> #dim
  select(label,qvalue,acrophase) |> 
  ggplot(aes(fill=acrophase))+
  theme_condense()+
  geom_brain(atlas = myaseg)+
    scale_fill_clock(rot=15,na.value="grey95")+
    facet_wrap(~int2extlab[measure],nrow=5)+
    theme_condense()+
  theme_void()

GM-qT1

meta <- get_glasser_spatial_meta()

# GM-qT1
fig4cSD |> 
  full_join(meta) |> 
  filter(is.na(`z-cog`)) |>  # To remove non-subcortical
  rename(label=roi) |> 
  select(label,var) |> 
  ggplot(aes(fill=var))+
  theme_condense()+
  scale_fill_gradientn(colours = c("blue","#C26179"),
                       na.value="grey95",limits=c(0,1))+
  geom_brain(atlas = myaseg)+
  theme_void()

Scaled Curves

tmp <- bsc |> filter(measure=="cbf")
acros <- seq(8,33,length.out=100)[-1]

ddf <- 
bsc |> 
    filter(measure=="cbf" | measure=="gm_md") |> 
  group_by(dx,measure) |> 
  nest() |> 
  mutate(ddf=map(data,function(tmp){
    par <- circular::mle.vonmises(circular::circular(tmp$acrophase/24*2*pi))
    data.frame(acros,
             dens=circular::dvonmises(circular::circular(acros/24*2*pi),
                            circamean(tmp$acrophase)/24*2*pi,
                            par$kappa))
})) |> select(-data) |> unnest(ddf) |> 
  mutate(dens=ifelse(measure=="cbf",dens*20/2+20,dens*0.0015/2+0.0015))

curv_and_dist_p2_comb <- 
    ggplot()+
    night_rect()+
  geom_line(data=bsc |>
              filter(measure=="cbf" | measure=="gm_md") |> 
              mutate(value=map2(amplitude,acrophase,cosinor_pred,time=9:33),
                     ltime=list(9:33)) |>
              unnest(c(value,ltime)),
            aes(ltime,value,group=subject,color=dx2lab(dx)),size=0.4,alpha=0.4)+
  geom_line(data=WB_Gcosinor_dx0 |> mutate(dx=0) |> 
              rbind(WB_Gcosinor_dx1 |> mutate(dx=1)) |> 
              filter(measure=="cbf" | measure=="gm_md") |> 
              mutate(value=map2(amplitude,acrophase,cosinor_pred,time=9:33),
                     ltime=list(9:33)) |>
              unnest(c(value,ltime)),
            aes(ltime,value,color=dx2lab(dx)),size=1.5)+
  # Densities
  geom_ribbon(data=ddf,
              aes(acros,y=1,ymax=dens,group=NA,
                  ymin=ifelse(measure=="cbf",20,0.0015)),
              alpha=0.6)+
    geom_point(data=bsc |> 
                 filter(measure=="cbf" | measure=="gm_md"),
              aes(ifelse(acrophase<8,acrophase+24,acrophase),group=NA,color=dx2lab(dx),
               y=ifelse(measure=="cbf",20,0.0015)*1.1),
              shape="l",size=4,alpha=0.7)+
  facet_grid(int2extlab[measure]~dx2lab(dx),scales="free",labeller = label_parsed)+
    scale_color_manual(values=c("BPD"=colors$dx1,
                                "CNTRL"=colors$dx0,
                                "Combined"=colors$dx01),guide='none')+
  scale_x_continuous(breaks = seq(8,32,4),labels = seq(8,32,4%%24))+
    ylab("Cosinor predicted values")+
    xlab("Time of Day (hr)")+
    theme_condense()
curv_and_dist_p2_comb 

Figure 4e TOD effects

allres <- 
    df |> 
  filter(measure=="cbf" | measure=="gm_md") |> 
    group_by(measure) |> nest() |> 
    mutate(res=map(data,function(x){
      lapply(1:9,function(ss1){
        ss2=ss1
        tdf <- x |> filter((session==ss1 & dx==0) | (session==ss2 & dx==1))
        res <- t.test(tdf$value[tdf$dx==1],tdf$value[tdf$dx==0])
        res |> glance() |> mutate(ss1,ss2)
      }) |> rbindlist() 
    })) |> unnest(res) 

# Source Data
fig4eSD <- 
  allres |> 
  select(session=ss1,estimate,measure) |> 
  mutate(tod=(session-1)*3+9) |> 
  mutate(measure=int2extlab[measure])
write_csv(fig4eSD,"output/source_data/Figure_4e.csv")

TODestimate_p_comb <- 
  fig4eSD |> 
  ggplot(aes(tod,estimate))+
  geom_col()+
  stat_smooth_cosinor(size=2,fullrange=TRUE)+
  xlab("Time of Day [hr] \n(session #)")+
  ylab("BPD - CNTRL")+
  # Linear order but ToD labels
  scale_x_continuous(breaks=seq(9,36,3),
                     labels = paste0(seq(9,36,3)%%24,"\n(",seq(1,9),")"))+
  facet_grid(measure~.,scales="free")+
    geom_hline(yintercept = 0)+
  theme_condense()
TODestimate_p_comb

Final Figure 4

Gcos_3grp_acrotick_p+labs(color="Group")+theme_condense_legend()+
  #
  gmmdcombgc+theme(legend.position="none")+ 
  theme(strip.text = element_text(size=6,color="black",
                                  margin = margin( b = 0, t = 0)))+
  gmqt1combaa+
  guides(fill = guide_colorbar(override.aes = list(size = 0.3)))+
  theme(legend.title = element_text(size = 6), 
        legend.text = element_text(size = 6),
        legend.key.size = unit(0.3, 'cm'))+
  theme(strip.text = element_text(size=6,color="black",
                                  margin = margin( b = 0, t = 0)))+
  #
  curv_and_dist_p2_comb+theme(legend.position="none")+
  #
  TODestimate_p_comb+
  #
  guide_area()+
  #-patchwork
  plot_layout(design = "
                    AAAAABBB
                    AAAAABBB
                    AAAAABBB
                    AAAAACCC
                    AAAAACCC
                    AAAAACCC
                    DDDE#FFF
                    DDDEGGGG")+
  plot_annotation(tag_levels = 'a')+
  plot_layout(guides = 'collect')


Click to see page metadata

Computation Started: 2023-10-11 20:00:47

Finished in 40.579 secs


Git Log

No git history available for this page


Packages

package version date
readxl 1.4.1 2023-10-10
backports 1.4.1 2023-10-10
systemfonts 1.0.4 2023-10-10
plyr 1.8.8 2023-10-10
lazyeval 0.2.2 2023-10-10
splines 4.1.3 2023-06-16
shinydashboard 0.7.2 2023-10-10
crosstalk 1.2.0 2023-10-10
GenomeInfoDb 1.30.1 2023-10-10
ggplot2 3.4.0 2023-10-10
digest 0.6.31 2023-10-10
foreach 1.5.2 2023-10-10
ca 0.71.1 2023-10-10
htmltools 0.5.4 2023-10-10
viridis 0.6.2 2023-10-10
magick 2.7.3 2023-10-10
fansi 1.0.4 2023-10-10
magrittr 2.0.3 2023-10-10
googlesheets4 1.0.1 2023-10-10
tzdb 0.3.0 2023-10-10
readr 2.1.3 2023-10-10
modelr 0.1.10 2023-10-10
matrixStats 0.63.0 2023-10-10
methods 4.1.3 2023-06-16
vroom 1.6.1 2023-10-10
svglite 2.1.1 2023-10-10
timechange 0.2.0 2023-10-10
colorspace 2.1-0 2023-10-10
rvest 1.0.3 2023-10-10
ggsegGlasser 1.0.01 2023-10-10
haven 2.5.1 2023-10-10
xfun 0.37 2023-10-10
dplyr 1.1.0 2023-10-10
crayon 1.5.2 2023-10-10
RCurl 1.98-1.10 2023-10-10
jsonlite 1.8.4 2023-10-10
iterators 1.0.14 2023-10-10
glue 1.6.2 2023-10-10
ggsegICBM 1.0.1 2023-10-10
kableExtra 1.3.4 2023-10-10
registry 0.5-1 2023-10-10
utils 4.1.3 2023-06-16
gtable 0.3.1 2023-10-10
gargle 1.3.0 2023-10-10
zlibbioc 1.40.0 2023-10-10
XVector 0.34.0 2023-10-10
webshot 0.5.4 2023-10-10
UpSetR 1.4.0 2023-10-10
DelayedArray 0.20.0 2023-10-10
BiocGenerics 0.40.0 2023-10-10
scales 1.2.1 2023-10-10
mvtnorm 1.1-3 2023-10-10
futile.options 1.0.1 2023-10-10
DBI 1.1.3 2023-10-10
graphics 4.1.3 2023-06-16
miniUI 0.1.1.1 2023-10-10
Rcpp 1.0.10 2023-10-10
viridisLite 0.4.1 2023-10-10
xtable 1.8-4 2023-10-10
units 0.8-2 2023-10-10
proxy 0.4-27 2023-10-10
bit 4.0.5 2023-10-10
stats4 4.1.3 2023-06-16
DT 0.27 2023-10-10
base 4.1.3 2023-06-16
htmlwidgets 1.6.1 2023-10-10
httr 1.4.4 2023-10-10
RColorBrewer 1.1-3 2023-10-10
ellipsis 0.3.2 2023-10-10
farver 2.1.1 2023-10-10
pkgconfig 2.0.3 2023-10-10
dbplyr 2.3.0 2023-10-10
utf8 1.2.3 2023-10-10
here 1.0.1 2023-10-10
labeling 0.4.2 2023-10-10
tidyselect 1.2.0 2023-10-10
rlang 1.0.6 2023-10-10
reshape2 1.4.4 2023-10-10
later 1.3.0 2023-10-10
stats 4.1.3 2023-06-16
munsell 0.5.0 2023-10-10
cellranger 1.1.0 2023-10-10
tools 4.1.3 2023-06-16
cli 3.6.0 2023-10-10
generics 0.1.3 2023-10-10
broom 1.0.3 2023-10-10
evaluate 0.20 2023-10-10
shinyBS 0.61.1 2023-10-10
stringr 1.5.0 2023-10-10
fastmap 1.1.0 2023-10-10
heatmaply 1.4.2 2023-10-10
yaml 2.3.7 2023-10-10
grDevices 4.1.3 2023-06-16
bit64 4.0.5 2023-10-10
knitr 1.42 2023-10-10
fs 1.6.1 2023-10-10
shinycssloaders 1.0.0 2023-10-10
zip 2.2.2 2023-10-10
purrr 1.0.1 2023-10-10
dendextend 1.16.0 2023-10-10
nlme 3.1-162 2023-10-10
DiscoRhythm 1.10.1 2023-10-10
mime 0.12 2023-10-10
formatR 1.14 2023-10-10
ggExtra 0.10.0 2023-10-10
xml2 1.3.3 2023-10-10
BiocStyle 2.22.0 2023-10-10
compiler 4.1.3 2023-06-16
rstudioapi 0.14 2023-10-10
plotly 4.10.1 2023-10-10
e1071 1.7-13 2023-10-10
reprex 2.0.2 2023-10-10
tibble 3.1.8 2023-10-10
stringi 1.7.12 2023-10-10
highr 0.10 2023-10-10
futile.logger 1.4.3 2023-10-10
forcats 1.0.0 2023-10-10
circular 0.4-95 2023-10-10
lattice 0.20-45 2023-06-16
Matrix 1.5-1 2023-10-10
classInt 0.4-9 2023-10-10
shinyjs 2.1.0 2023-10-10
vctrs 0.5.2 2023-10-10
ggseg3d 1.6.3 2023-10-10
pillar 1.8.1 2023-10-10
lifecycle 1.0.3 2023-10-10
BiocManager 1.30.19 2023-10-10
data.table 1.14.6 2023-10-10
bitops 1.0-7 2023-10-10
seriation 1.4.1 2023-10-10
httpuv 1.6.8 2023-10-10
patchwork 1.1.2 2023-10-10
GenomicRanges 1.46.1 2023-10-10
R6 2.5.1 2023-10-10
promises 1.2.0.1 2023-10-10
TSP 1.2-2 2023-10-10
renv 0.17.3 2023-10-11
KernSmooth 2.23-20 2023-06-16
gridExtra 2.3 2023-10-10
IRanges 2.28.0 2023-10-10
codetools 0.2-19 2023-10-10
lambda.r 1.2.4 2023-10-10
boot 1.3-28.1 2023-10-10
assertthat 0.2.1 2023-10-10
SummarizedExperiment 1.24.0 2023-10-10
rprojroot 2.0.3 2023-10-10
withr 2.5.0 2023-10-10
S4Vectors 0.32.4 2023-10-10
datasets 4.1.3 2023-06-16
GenomeInfoDbData 1.2.7 2023-10-10
mgcv 1.8-41 2023-10-10
parallel 4.1.3 2023-06-16
hms 1.1.2 2023-10-10
VennDiagram 1.7.3 2023-10-10
grid 4.1.3 2023-06-16
tidyverse 1.3.2 2023-10-10
class 7.3-21 2023-10-10
tidyr 1.3.0 2023-10-10
rmarkdown 2.20 2023-10-10
MatrixGenerics 1.6.0 2023-10-10
googledrive 2.0.0 2023-10-10
git2r 0.31.0 2023-10-10
sf 1.0-12 2023-10-10
ggseg 1.6.6 2023-10-10
Biobase 2.54.0 2023-10-10
shiny 1.7.4 2023-10-10
lubridate 1.9.1 2023-10-10

System Information

systemInfo
version R version 4.1.3 (2022-03-10)
platform x86_64-pc-linux-gnu (64-bit)
locale en_US.UTF-8
OS Ubuntu 20.04.6 LTS
UI X11

Scikick Configuration

cat scikick.yml
### Scikick Project Workflow Configuration File

# Directory where Scikick will store all standard notebook outputs
reportdir: report

# --- Content below here is best modified by using the Scikick CLI ---

# Notebook Execution Configuration (format summarized below)
# analysis:
#  first_notebook.Rmd:
#  second_notebook.Rmd:
#  - first_notebook.Rmd         # must execute before second_notebook.Rmd
#  - functions.R                # file is used by second_notebook.Rmd
#
# Each analysis item is executed to generate md and html files, E.g.:
# 1. <reportdir>/out_md/first_notebook.md
# 2. <reportdir>/out_html/first_notebook.html

analysis: !!omap
- code/methods/methods_walkthrough.Rmd:
- code/methods/Gcosinor_implementation_check.Rmd: []
- code/results/WB_S-cosinor.Rmd: []
- code/results/WB_G-cosinor.Rmd:
  - code/results/WB_S-cosinor.Rmd
- code/results/WB_acrophase_agnostic_tests.Rmd:
  - code/results/WB_S-cosinor.Rmd
- code/results/ROI_S-cosinor.Rmd: []
- code/results/ROI_G-cosinor.Rmd:
  - code/results/ROI_S-cosinor.Rmd
- code/results/ROI_acrophase_agnostic_tests.Rmd:
  - code/results/ROI_S-cosinor.Rmd
- code/results/body_weight.Rmd: []
- code/results/WB_cosinor_stats_BPD.Rmd: []
- code/results/ROI_cosinor_stats_BPD.Rmd: []
- code/results/WB_BPD_diffs.Rmd:
  - code/results/WB_cosinor_stats_BPD.Rmd
  - code/results/WB_S-cosinor.Rmd
- code/display_items/table_1.Rmd:
  - code/display_items/figure_S5_actigraphy.Rmd
  - code/results/body_weight.Rmd
- code/display_items/table_2.Rmd:
  - code/results/WB_G-cosinor.Rmd
  - code/results/WB_acrophase_agnostic_tests.Rmd
  - code/results/body_weight.Rmd
  - code/results/ROI_G-cosinor.Rmd
  - code/results/ROI_acrophase_agnostic_tests.Rmd
- code/display_items/figure_2.Rmd:
  - code/results/WB_G-cosinor.Rmd
  - code/results/WB_acrophase_agnostic_tests.Rmd
  - code/results/body_weight.Rmd
- code/display_items/figure_3.Rmd:
  - code/results/ROI_S-cosinor.Rmd
  - code/results/ROI_G-cosinor.Rmd
  - code/results/WB_G-cosinor.Rmd
- code/display_items/figure_4.Rmd:
  - code/results/WB_G-cosinor.Rmd
  - code/results/WB_acrophase_agnostic_tests.Rmd
  - code/results/WB_cosinor_stats_BPD.Rmd
  - code/results/WB_BPD_diffs.Rmd
  - code/results/ROI_cosinor_stats_BPD.Rmd
  - code/results/ROI_G-cosinor.Rmd
  - code/results/ROI_acrophase_agnostic_tests.Rmd
- code/display_items/table_S1_techvar.Rmd:
- code/display_items/table_S3_adjweight.Rmd: []
- code/display_items/figure_S4_spatialG.Rmd:
  - code/results/ROI_G-cosinor.Rmd
- code/display_items/figure_S5_actigraphy.Rmd: []
- code/display_items/figure_S6_phasePSQI.Rmd:
  - code/results/WB_cosinor_stats_BPD.Rmd
  - code/results/WB_S-cosinor.Rmd
- code/index.Rmd:
  - README.md
snakefile_args:
  singularity: /external/EPIGENETICS/SCRATCH/automator/share/singularity/shared3.img
version_info:
  snakemake: 6.3.0
  ruamel.yaml: 0.16.5
  scikick: 0.2.0
# Optional site theme customization
output:
  BiocStyle::html_document:
    code_folding: show
    theme: readable
    toc_float: true
    toc: true
    number_sections: false
    toc_depth: 5
    self_contained: true

Functions

acro2complex

function (acro, per = 24) 
{
    z <- complex(real = cos(acro/per * 2 * pi), imaginary = sin(acro/per * 
        2 * pi))
    return(z)
}
<bytecode: 0x55c01fcccd50>

ampacro2cos

function (amp, acro, per = 24) 
amp * cos(acro/per * 2 * pi)

ampacro2sin

function (amp, acro, per = 24) 
amp * sin(acro/per * 2 * pi)

circamean

function (x, ...) 
{
    ret <- {
        function(x) (x * 24/(2 * pi))%%24
    }(Arg(mean(acro2complex(x))))
    return(ret)
}
<bytecode: 0x55c0200af250>

circdist

function (acro1, acro2, per = 24) 
{
    tmp <- (acro1 - acro2)%%per
    idx <- which(tmp > (per/2))
    tmp[idx] <- tmp[idx] - per
    return(tmp)
}

coord_circpolar

function (...) 
{
    list(coord_polar(...), scale_x_continuous(limits = c(0, 24), 
        breaks = seq(0, 24, 3)), scale_y_continuous(limits = c(-1, 
        NA)), theme(panel.grid.minor.x = element_blank(), panel.grid.minor.y = element_blank(), 
        panel.grid.major.x = element_blank()), geom_hline(yintercept = 0, 
        color = "grey"))
}

cosinor_pred

function (time, A, acro, mesor = 0, per = 24) 
{
    mesor + A * cos((time - acro) * 2 * pi/per)
}
<bytecode: 0x55c02e99d708>

dcast

function (data, formula, fun.aggregate = NULL, ..., margins = NULL, 
    subset = NULL, fill = NULL, drop = TRUE, value.var = guess_value(data)) 
{
    formula <- parse_formula(formula, names(data), value.var)
    if (length(formula) > 2) {
        stop("Dataframes have at most two output dimensions")
    }
    if (!is.null(margins)) {
        data <- add_margins(data, lapply(formula, names), margins)
    }
    res <- cast(data, formula, fun.aggregate, ..., subset = subset, 
        fill = fill, drop = drop, value.var = value.var)
    data <- as.data.frame.matrix(res$data, stringsAsFactors = FALSE)
    names(data) <- array_names(res$labels[[2]])
    stopifnot(nrow(res$labels[[1]]) == nrow(data))
    cbind(res$labels[[1]], data)
}
<bytecode: 0x55c001c40840>
<environment: namespace:reshape2>

discoCosinor

function (x, zts, per = 24) 
{
    Y <- as.matrix(x)
    res <- lmCSmatNoNA(Y[NULL, ], zts, per)
    res[seq_len(nrow(Y)), ] <- NA
    obsinds <- t(!is.na(Y))
    obstypes <- unique(obsinds, MARGIN = 2)
    obstypes <- obstypes[, colSums(obstypes) > 2, drop = FALSE]
    for (i in seq_len(ncol(obstypes))) {
        inds <- colMeans(obsinds == obstypes[, i]) == 1
        res[inds, ] <- lmCSmatNoNA(Y[inds, obstypes[, i], drop = FALSE], 
            zts[obstypes[, i]], per)
    }
    res
}
<bytecode: 0x55c0150d7420>
<environment: namespace:DiscoRhythm>

discoPMcos

function (x, period = 24, idname = NULL, alpha = 0.05) 
{
    if (is.data.frame(x)) 
        x <- split(x, 1:nrow(x))
    isdup <- F
    if (nrow(x[[1]]) == 1) {
        isdup <- T
        x <- lapply(x, function(y) rbind(y, y))
    }
    betas <- sapply(x, function(a) a$sincoef)
    gammas <- sapply(x, function(a) a$coscoef)
    mesors <- sapply(x, function(a) a$mesor)
    beta <- rowMeans(betas)
    gamma <- rowMeans(gammas)
    MESOR <- rowMeans(mesors)
    amplitude <- sqrt(beta^2 + gamma^2)
    acrophase_rad <- atan2(beta, gamma)
    sdm <- matrixStats::rowSds(mesors)
    sdb <- matrixStats::rowSds(betas)
    sdy <- matrixStats::rowSds(gammas)
    covby <- diag(cov(t(betas), t(gammas)))
    k <- ncol(betas)
    denom <- amplitude^2 * k
    c22 <- (sdb^2 * beta^2 + 2 * covby * beta * gamma + sdy^2 * 
        gamma^2)/denom
    c23 <- ((-1 * (sdb^2 - sdy^2)) * (beta * gamma) + covby * 
        (beta^2 - gamma^2))/denom
    c33 <- (sdb^2 * gamma^2 - 2 * covby * beta * gamma + sdy^2 * 
        beta^2)/denom
    t <- abs(qt(alpha/2, df = k - 1))
    mesoru <- MESOR + ((t * sdm)/sqrt(k))
    mesorl <- MESOR - ((t * sdm)/sqrt(k))
    ampu <- amplitude + (t * sqrt(c22))
    ampl <- amplitude - (t * sqrt(c22))
    tmp <- vapply(seq_along(ampu), function(i) {
        if (ampu[i] > 0 & ampl[i] < 0) {
            return(c(NA, NA))
        }
        dn <- amplitude[i]^2 - c22[i] * t^2
        crit <- t * sqrt(c33[i]) * sqrt(amplitude[i]^2 - (c22[i] * 
            c33[i] - c23[i]^2) * (t^2/c33[i]))
        return(c(acrophase_rad[i] + atan((c23[i] * t^2 + crit)/dn), 
            acrophase_rad[i] + atan((c23[i] * t^2 - crit)/dn)))
    }, numeric(2))
    fiu <- tmp[1, ]
    fil <- tmp[2, ]
    r <- diag(cor(t(betas), t(gammas)))
    frac1 <- (k * (k - 2))/(2 * (k - 1))
    frac2 <- 1/(1 - r^2)
    frac3 <- beta^2/sdb^2
    frac4 <- (beta * gamma)/(sdb * sdy)
    frac5 <- gamma^2/sdy^2
    brack <- frac3 - 2 * r * frac4 + frac5
    Fvalue <- frac1 * frac2 * brack
    df2 <- k - 2
    pvalue <- pf(q = Fvalue, df1 = 2, df2 = df2, lower.tail = F)
    ret <- data.frame(F = Fvalue, df1 = 2, df2 = k - 2, pvalue, 
        qvalue = p.adjust(pvalue, "fdr"), MESOR, amplitude = amplitude, 
        acrophase = (acrophase_rad/2/pi * period + period)%%period, 
        MESOR_l = mesorl, MESOR_u = mesoru, amp_l = ampl, amp_u = ampu, 
        acro_l = (fil/2/pi * period + period)%%period, acro_u = (fiu/2/pi * 
            period + period)%%period)
    idx <- which(ret$acro_l > ret$acro_u)
    ret$acro_l[idx] <- ret$acro_l[idx] - period
    idx <- which((ret$acro_l < ret$acro & ret$acro_u < ret$acro))
    ret$acro_l[idx] <- ret$acro_l[idx] + period
    ret$acro_u[idx] <- ret$acro_u[idx] + period
    idx <- which((ret$acro_l > ret$acro & ret$acro_u > ret$acro))
    ret$acro_l[idx] <- ret$acro_l[idx] - period
    ret$acro_u[idx] <- ret$acro_u[idx] - period
    if (!is.null(idname)) {
        rownames(ret) <- x[[1]][[idname]]
    }
    else {
        rownames(ret) <- rownames(x[[1]])
    }
    if (isdup) 
        ret <- ret[1, ]
    return(ret)
}

dx2lab

function (x) 
{
    return(ifelse(as.character(x) == "1", "BPD", "CNTRL"))
}
<bytecode: 0x55c020593bf8>

geom_smooth_cosinor

function (...) 
geom_smooth(method = "lm", formula = y ~ sinpi(x/12) + cospi(x/12), 
    ...)

get_glasser_spatial_meta

function () 
{
    meta <- readxl::read_xlsx("data/reference_files/MMP1_CSV_file.xlsx")
    meta <- meta %>% mutate(region = ifelse(region == "7Pl", 
        "7PL", region)) %>% mutate(regionName = ifelse(regionName == 
        "7Pl_L", "7PL_L", regionName)) %>% mutate(regionName = ifelse(regionName == 
        "7Pl_R", "7PL_R", regionName))
    meta$roi <- paste(meta$LR, gsub("_[LR]", "", meta$regionName), 
        "ROI", sep = "_")
    meta$hemi <- ifelse(meta$LR == "L", "left", "right")
    return(meta)
}
<bytecode: 0x55c0213ce5a0>

get_icbm_spatial_meta

function () 
{
    meta <- readxl::read_xlsx("data/reference_files/JHU_ICBM81.xlsx")
    meta <- meta[-c(1:2), ]
    meta$region <- meta$label %>% gsub(" ", "_", .) %>% gsub("\\(", 
        "", .) %>% gsub("\\)", "", .) %>% gsub("\\/", "or", .)
    meta$roi <- meta$region
    meta <- meta %>% mutate(region = gsub(" R$", "", label)) %>% 
        mutate(region = gsub(" L$", "", region)) %>% filter(region != 
        "Unclassified")
    return(meta)
}
<bytecode: 0x55c025f4f0e8>

get_subcor_ggseg_atlas

function () 
{
    library(ggseg)
    library(ggsegGlasser)
    meta <- get_glasser_spatial_meta()
    pdf <- full_join(unique(select(read_csv("data/available_upon_request/processed_ROI_data.csv") %>% 
        filter(measure == "cbf"), roi)), meta) %>% filter(is.na(`z-cog`)) %>% 
        rename(label = roi) %>% ungroup() %>% select(label)
    myaseg <- aseg
    myaseg$data <- myaseg$data %>% filter(label %in% pdf$label)
    return(myaseg)
}
<bytecode: 0x55c01b94d708>

groupWiseSummaryPvalTable

function (dat, as_kable = FALSE) 
{
    ret <- dat %>% group_by(grp) %>% summarize(res = list(summaryPvalTable(pvalue))) %>% 
        unnest(res) %>% mutate(val = paste0(percent, " (", count, 
        ")")) %>% reshape2::dcast(level ~ grp, value.var = "val")
    if (as_kable) 
        ret <- knitr::kable(ret)
    return(ret)
}

icbm_preprocess

function (df) 
{
    df %>% filter(region != "Fornix (column and body of fornix)") %>% 
        mutate(roi = str_pad(index, 3, pad = "0"))
}

my_val_formatter

function (x, doparse = T, mf = T, ...) 
{
    ifelse(x > 10000 | (x > 0 & x < 0.001) | (x < 0 & x > -0.001), 
        {
            txt1 <- (scales::scientific_format(digits = 2))(x)
            if (mf) {
                txt <- gsub("e\\+*", " %*% 10^", txt1)
            }
            else {
                return(txt1)
            }
            if (doparse) {
                return(parse(text = txt))
            }
            else {
                return(txt)
            }
        }, formatC(x, format = "fg", digits = 2, flag = "#", 
            big.mark = ","))
}

myfmt

function (x) 
formatC(x, digits = 2)

myfmt2

function (x) 
my_val_formatter(x, mf = F)

night_rect

function () 
{
    annotate(geom = "rect", ymin = -Inf, ymax = Inf, xmin = 24, 
        xmax = 32, alpha = 0.8, fill = "grey", color = NA)
}

night_rect_early

function () 
{
    annotate(geom = "rect", ymin = -Inf, ymax = Inf, xmin = 0, 
        xmax = 8, alpha = 0.8, fill = "grey", color = NA)
}

night_recty

function () 
{
    annotate(geom = "rect", xmin = -Inf, xmax = Inf, ymin = 24, 
        ymax = 32, alpha = 0.8, fill = "grey", color = NA)
}

night_recty_early

function () 
{
    annotate(geom = "rect", xmin = -Inf, xmax = Inf, ymin = 0, 
        ymax = 8, alpha = 0.8, fill = "grey", color = NA)
}

pqlabs

function (p = NULL, q = NULL) 
{
    if (!is.null(p) & is.null(q)) {
        lab <- rep("p>0.05", length(p))
        lab[p < 0.05] <- "p<0.05"
        levs <- c("p>0.05", "p<0.05")
    }
    else if (is.null(p) & !is.null(q)) {
        lab <- rep("q>0.05", length(q))
        lab[q < 0.05] <- "q<0.05"
        levs <- c("q>0.05", "q<0.05")
    }
    else if (!is.null(p) & !is.null(q)) {
        stopifnot(length(p) == length(q))
        lab <- rep("p>0.05", length(p))
        lab[p < 0.05] <- "p<0.05"
        lab[q < 0.05] <- "q<0.05"
        levs <- c("p>0.05", "p<0.05", "q<0.05")
    }
    return(factor(lab, levels = levs))
}

rsqGcos

function (pmr, dat) 
{
    predat2 <- group_by(mutate(group_by(inner_join(pmr, dat), 
        measure, roi, subject), dmval = value - mean(value)), 
        measure, roi)
    rsqdf <- summarize(mutate(mutate(mutate(mutate(predat2, sr1 = (value - 
        cosinor_pred(time, amplitude, acrophase, MESOR))^2), 
        ts1 = (value - MESOR)^2), sr2 = (dmval - cosinor_pred(time, 
        amplitude, acrophase, 0))^2), ts2 = (dmval - 0)^2), rsq = 1 - 
        sum(sr1)/sum(ts1), rsqdm = 1 - sum(sr2)/sum(ts2))
    return(inner_join(pmr, rsqdf))
}

scale_alpha_fgbg

function (alpha_bg = 0.3, ...) 
scale_alpha_manual(values = c(`TRUE` = 1, `FALSE` = alpha_bg, 
    ...))

scale_color_clock

function (rot = 0, ...) 
scale_color_gradientn(colors = rainbow(24)[((1:24) - 1 + rot)%%24 + 
    1], limits = c(0, 24), ...)

scale_color_dx

function () 
{
    scale_color_manual(values = c(`1` = colors$dx1, `0` = colors$dx0))
}

scale_color_dxlab

function (...) 
{
    scale_color_manual(values = c(BPD = colors$dx1, CNTRL = colors$dx0, 
        ...))
}

scale_color_fgbg

function (fgcol = "red", ...) 
scale_color_manual(values = c(`TRUE` = fgcol, `FALSE` = "grey20", 
    ...))

scale_fill_clock

function (rot = 0, ...) 
scale_fill_gradientn(colors = rainbow(24)[((1:24) - 1 + rot)%%24 + 
    1], limits = c(0, 24), ...)
<bytecode: 0x55c021580cb8>

scale_fill_dx

function () 
{
    scale_fill_manual(values = c(`1` = colors$dx1, `0` = colors$dx0))
}

scale_fill_dxlab

function () 
{
    scale_fill_manual(values = c(BPD = colors$dx1, CNTRL = colors$dx0))
}

scale_fill_fgbg

function (fgcol = "red", ...) 
scale_fill_manual(values = c(`TRUE` = fgcol, `FALSE` = "grey20", 
    ...))

scale_x_circ

function () 
scale_x_continuous(limits = c(0, 24), breaks = seq(0, 24, 6))

session_is_day2

function (session, time) 
{
    (session >= 6 & session <= 9) & time < 12
}

sincos2acro

function (sin, cos, per = 24) 
{
    (atan2(sin, cos)/2/pi * per + per)%%per
}
<bytecode: 0x55c0150cd0d8>
<environment: namespace:DiscoRhythm>

sincos2amp

function (sin, cos) 
sqrt(sin^2 + cos^2)
<bytecode: 0x55c0150ce9d8>
<environment: namespace:DiscoRhythm>

stat_smooth_cosinor

function (...) 
stat_smooth(geom = "line", method = "lm", formula = y ~ sinpi(x/12) + 
    cospi(x/12), ...)

summaryPvalTable

function (p, as_kable = FALSE) 
{
    ps <- list()
    ps[[1]] <- p < 0.05
    ps[[2]] <- p < 0.01
    ps[[3]] <- p.adjust(p, method = "fdr") < 0.05
    ps[[4]] <- p.adjust(p, method = "bonferroni") < 0.05
    levs <- c("p < 0.05", "p < 0.01", "FDR", "Bonferroni")
    perc <- sapply(ps, function(p) round(mean(p, na.rm = TRUE), 
        4)) * 100
    sums <- sapply(ps, function(p) sum(p, na.rm = TRUE))
    ret <- data.frame(level = levs, count = sums, percent = paste0(perc, 
        "%"), stringsAsFactors = FALSE)
    if (as_kable) 
        ret <- knitr::kable(ret)
    return(ret)
}

theme_condense

function () 
{
    list(theme(strip.background = element_rect(color = "white", 
        fill = "white")), theme(strip.text = element_text(size = 7, 
        color = "black", margin = margin(b = 0, t = 0))), theme(axis.text = element_text(size = 7)))
}
<bytecode: 0x55c010559e78>

theme_condense_legend

function () 
{
    list(guides(shape = guide_legend(override.aes = list(size = 0.3))), 
        guides(color = guide_legend(override.aes = list(size = 0.3))), 
        guides(fill = guide_legend(override.aes = list(size = 0.3))), 
        theme(legend.title = element_text(size = 6), legend.text = element_text(size = 6), 
            legend.key.size = unit(0.3, "cm")))
}


Next (Project Map) skmap cluster_code/methods/ code/methods/ cluster_code/results/ code/results/ cluster_code/ code/ cluster_code/display_items/ code/display_items/ cluster_/ / code/results/body_weight.Rmd Body Weight code/display_items/table_1.Rmd Table 1 code/results/body_weight.Rmd->code/display_items/table_1.Rmd code/display_items/table_2.Rmd Table 2 code/results/body_weight.Rmd->code/display_items/table_2.Rmd code/display_items/figure_2.Rmd Figure 2 code/results/body_weight.Rmd->code/display_items/figure_2.Rmd code/results/WB_G-cosinor.Rmd WB G-cosinor code/results/WB_G-cosinor.Rmd->code/display_items/table_2.Rmd code/results/WB_G-cosinor.Rmd->code/display_items/figure_2.Rmd code/display_items/figure_3.Rmd Figure 3 code/results/WB_G-cosinor.Rmd->code/display_items/figure_3.Rmd code/display_items/figure_4.Rmd Figure 4 code/results/WB_G-cosinor.Rmd->code/display_items/figure_4.Rmd code/results/WB_acrophase_agnostic_tests.Rmd WB Acrophase Agnostic Tests code/results/WB_acrophase_agnostic_tests.Rmd->code/display_items/table_2.Rmd code/results/WB_acrophase_agnostic_tests.Rmd->code/display_items/figure_2.Rmd code/results/WB_acrophase_agnostic_tests.Rmd->code/display_items/figure_4.Rmd code/results/ROI_G-cosinor.Rmd ROI G-cosinor code/results/ROI_G-cosinor.Rmd->code/display_items/table_2.Rmd code/results/ROI_G-cosinor.Rmd->code/display_items/figure_3.Rmd code/results/ROI_G-cosinor.Rmd->code/display_items/figure_4.Rmd code/display_items/figure_S4_spatialG.Rmd Figure S4 SpatialG code/results/ROI_G-cosinor.Rmd->code/display_items/figure_S4_spatialG.Rmd code/results/ROI_acrophase_agnostic_tests.Rmd ROI Acrophase Agnostic Tests code/results/ROI_acrophase_agnostic_tests.Rmd->code/display_items/table_2.Rmd code/results/ROI_acrophase_agnostic_tests.Rmd->code/display_items/figure_4.Rmd code/results/ROI_S-cosinor.Rmd ROI S-cosinor code/results/ROI_S-cosinor.Rmd->code/results/ROI_G-cosinor.Rmd code/results/ROI_S-cosinor.Rmd->code/results/ROI_acrophase_agnostic_tests.Rmd code/results/ROI_S-cosinor.Rmd->code/display_items/figure_3.Rmd code/results/WB_cosinor_stats_BPD.Rmd WB Cosinor Stats BPD code/results/WB_cosinor_stats_BPD.Rmd->code/display_items/figure_4.Rmd code/results/WB_BPD_diffs.Rmd WB BPD Diffs code/results/WB_cosinor_stats_BPD.Rmd->code/results/WB_BPD_diffs.Rmd code/display_items/figure_S6_phasePSQI.Rmd Figure S6 PhasePSQI code/results/WB_cosinor_stats_BPD.Rmd->code/display_items/figure_S6_phasePSQI.Rmd code/results/WB_BPD_diffs.Rmd->code/display_items/figure_4.Rmd code/results/ROI_cosinor_stats_BPD.Rmd ROI Cosinor Stats BPD code/results/ROI_cosinor_stats_BPD.Rmd->code/display_items/figure_4.Rmd code/results/WB_S-cosinor.Rmd WB S-cosinor code/results/WB_S-cosinor.Rmd->code/results/WB_G-cosinor.Rmd code/results/WB_S-cosinor.Rmd->code/results/WB_acrophase_agnostic_tests.Rmd code/results/WB_S-cosinor.Rmd->code/results/WB_BPD_diffs.Rmd code/results/WB_S-cosinor.Rmd->code/display_items/figure_S6_phasePSQI.Rmd README.md README.md code/index.Rmd Index README.md->code/index.Rmd code/methods/methods_walkthrough.Rmd Methods Walkthrough code/methods/Gcosinor_implementation_check.Rmd Gcosinor Implementation Check code/display_items/figure_S5_actigraphy.Rmd Figure S5 Actigraphy code/display_items/figure_S5_actigraphy.Rmd->code/display_items/table_1.Rmd code/display_items/table_S1_techvar.Rmd Table S1 Techvar code/display_items/table_S3_adjweight.Rmd Table S3 Adjweight